home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / datature / omahadb / sort.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1988-11-05  |  11.5 KB  |  230 lines
  1. 1000  REM ******* SORT PROGRAM ******
  2. 1005  COMMON G1$,G2$,G3$
  3. 1006  GOSUB 1010:GOTO 1020
  4. 1010  ON ERROR GOTO 0:RETURN 'ON ERROR GOTO 30000
  5. 1020  DIM U%(22):FOR I=0 TO 21:READ U%(I):NEXT:DATA&H8B55,&HB8EC,&H0600,&H07B7,&H768B,&H8A0C,&H8B2C,&HA76,&HC8A,&H768B,&H8A08,&H8B34,&H676,&H148A,&HCDFE,&HC9FE,&HCEFE,&HCAFE,&H10CD,&HCA5D,&H8,&H0
  6. 1030  OPEN "DD" FOR INPUT AS 1: INPUT #1,DR$:CLOSE
  7. 1040  DEF FNPN(S)=CVI(MID$(P$(0),S*2-1,2))
  8. 1041  DEF FNMFP(F)=CVI(MID$(P$(F),1,2))
  9. 1042  DEF FNNP(F)=CVI(MID$(P$(F),3,2))
  10. 1043  DEF FNL(Y)=7+(Y MOD 10)+(-10*(Y MOD 10 = 0))
  11. 1048  MF$="###################,.##"
  12. 1050  IF CHR$(SCREEN(2,27))<>"T" THEN CLS: COLOR 0,7:PRINT SPACE$(240):LOCATE 2,27:PRINT "The Omaha DataBase Program":LOCATE 1,1:PRINT"KEY";STRING$(78,"THEN");"CLOSE":LOCATE 2,1:PRINT "OPEN":LOCATE 2,80:PRINT "OPEN":LOCATE 3,1:PRINT "SCREEN";STRING$(78,"THEN");"LOAD": COLOR 7,0
  13. 1060  KEY OFF:FOR G=1 TO 10:KEY G,"":NEXT
  14. 1070  LIN$="F1 "+CHR$(24)+" F2 "+CHR$(25)+" F3 SUB"+CHR$(25)+" F4 SUB"+CHR$(26)+" F5 SUB"+CHR$(24)+" F6 MAS"+CHR$(26)+" F7 ANY# F8 DEL  F9 ORGNAL F10 RETURN"
  15. 1080  DIM X$(6,70),T$(6,70),BB(6,70),BL(6,70),T(6,70),K(7,4)
  16. 1090  RESET:GOSUB 1130
  17. 1100  LOCATE 2,3:PRINT TIME$:LOCATE 2,69:PRINT DATE$
  18. 1120  GOSUB 1130: GOSUB 1180:GOTO 3000
  19. 1130  R1%=4:R2%=24:C1%=1:C2%=80:GOTO 1160: REM SCREEN CLEAR
  20. 1140  R1%=4:R2%=19:C1%=1:C2%=80:GOTO 1160: REM SCREEN CLEAR
  21. 1150  R1%=21:R2%=23:C1%=2:C2%=78:GOTO 1160: REM BOX CLEAR
  22. 1160  DEF SEG: SUBRT%=VARPTR(U%(0)):CALL SUBRT%(R1%,C1%,R2%,C2%):RETURN
  23. 1170  LOCATE 20,1: PRINT "KEY";STRING$(77,"THEN");"CLOSE":LOCATE 21,1:PRINT "OPEN":LOCATE 21,79:PRINT "OPEN":LOCATE 22,1:PRINT "OPEN":LOCATE 22,79:PRINT "OPEN":LOCATE 23,1:PRINT"OPEN":LOCATE 23,79:PRINT"OPEN";:LOCATE 24,1:PRINT "SCREEN";STRING$(77,"THEN");"LOAD";:RETURN:REM BOX
  24. 1180  REM FORMAT FILE
  25. 1190  F$=DR$+":FORMAT"
  26. 1200  OPEN F$ FOR INPUT AS #7:
  27. 1210  FOR F=0 TO 6:IF EOF(7) THEN 1220 ELSE INPUT #7,F$(F),LL(F),TE(F),DR$(F):FOR Y=1 TO TE(F):INPUT #7,T$(F,Y),T(F,Y),BB(F,Y),BL(F,Y):NEXT:NEXT
  28. 1220  CLOSE:TF=F-1
  29. 1230  RETURN
  30. 1240  PLAY "MB":FOR I9=1 TO 3:FOR J9=2 TO 4:PLAY "L64T255O=J9;CC#DD#EFF#GG#AA#B":NEXT:NEXT:RETURN
  31. 1250  PLAY "MB":FOR I9=1 TO 2:FOR J9=2 TO 4:PLAY "L64T255O=J9;D#EFF#GG#A":NEXT:NEXT:RETURN
  32. 1260  PLAY "MB":FOR I9=1 TO 6:FOR J9=2 TO 4:PLAY "L64T200O=J9;DEFGA":NEXT:NEXT:RETURN
  33. 1270  LOCATE 23,3: COLOR 15:PRINT "INCORRECT ENTRY":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  34. 1275  LOCATE 23,3: COLOR 15:PRINT "TOO HIGH!!":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  35. 1276  LOCATE 23,3: COLOR 15:PRINT "NO RECORD TO DELETE!!!":COLOR 7,0:GOSUB 1260:GOSUB 1150:RETURN
  36. 1277  LOCATE 23,3:COLOR 15: PRINT "SUB-FILE NOT LINKED WITH MASTER FILE":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  37. 1278  LOCATE 23,3:COLOR 15: PRINT "PROBLEM WITH LATERAL LINKAGE: REPAIR THIS FILE!":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  38. 1279  LOCATE 23,3:COLOR 15: PRINT "DELETED RECORD!!!":COLOR 7,0:GOSUB 1250::GOSUB 1150:RETURN
  39. 1800  REM OPEN FILE
  40. 1810  FI$(F)=DR$(F)+":"+F$(F):QZ=4:IF F=0 THEN QZ=10:
  41. 1820  OPEN FI$(F) AS #F+1 LEN=LL(F):FIELD #F+1,QZ AS P$(F):FOR Y=1 TO TE(F)
  42. 1830  IF QZ>510 THEN FIELD #F+1,255 AS Q1$,255 AS Q2$,QZ-510 AS Q3$,BL(F,Y) AS X$(F,Y) ELSE IF QZ>255 THEN FIELD #F+1,255 AS Q1$,QZ-255 AS Q2$,BL(F,Y) AS X$(F,Y) ELSE IF QZ=<255 THEN FIELD #F+1,QZ AS Q1$,BL(F,Y) AS X$(F,Y)
  43. 1840  QZ=QZ+BL(F,Y):NEXT
  44. 1850  RETURN
  45. 1860  FI$=DR$+":REC":OPEN FI$ FOR INPUT AS #7
  46. 1870  IF EOF(7) THEN 1880
  47. 1875  FOR G=0 TO TF:INPUT #7,NR(G),DL(G):NEXT:
  48. 1880  CLOSE #7:FOR G=0 TO TF: IF NR(G)=0 THEN NR(G)=1:
  49. 1890  NEXT
  50. 1900  RETURN
  51. 1910  FI$=DR$=":REC":OPEN FI$ FOR OUTPUT AS #7: FOR G=0 TO TF:WRITE#7,NR(G),DL(G):NEXT:CLOSE #7:RETURN
  52. 2130  REM INPUT ROUTINE
  53. 2140  R=CSRLIN:C=POS(0):FLAG=0
  54. 2150  IN$=""
  55. 2160  DEF SEG=0:POKE &H6A,0:POKE 1052,PEEK(1050)
  56. 2170  C3=C+LEN(IN$):COLOR 18:IF T(F,Y)<>3 THEN 2175 ELSE C3=C+LEN(IN$)+(-1*(LEN(IN$)=>2))+(-1*(LEN(IN$)=>4))
  57. 2175  LOCATE R,C3:PRINT CHR$(SCREEN(R,C3))
  58. 2180  I$=INKEY$:IF I$="" THEN 2180
  59. 2190  COLOR 0,7:LOCATE R,C+LEN(IN$):PRINT CHR$(SCREEN(R,C+LEN(IN$)))
  60. 2200  IF ASC(LEFT$(I$,1))=0 THEN FLAG=ASC(MID$(I$,2))-58:BEEP:GOTO 2350
  61. 2210  IF I$=CHR$(8) AND LEN(IN$)>0 THEN IN$=LEFT$(IN$,LEN(IN$)-1):LOCATE R,C:PRINT IN$;" ":GOTO 2170 ELSE IF I$=CHR$(8) AND LEN(IN$)=0 THEN BEEP:GOTO 2180
  62. 2220  IF I$=CHR$(13) AND IN$="" THEN IN$=X$(F,Y):LSET X$(F,Y)=IN$:RETURN ELSE IF I$=CHR$(13) AND T(F,Y)<> 3 THEN LOCATE R,C:PRINT LEFT$(IN$+STRING$(50,32),BL(F,Y)):RETURN ELSE IF I$=CHR$(13) THEN RETURN
  63. 2230  IF I$=CHR$(27) THEN LOCATE R,C:PRINT STRING$(LEN(IN$),32);:GOTO 2170
  64. 2240  IF T(F,Y)=1 THEN 2280
  65. 2250  IF T(F,Y)=2 AND INSTR("0123456789+=-Ee#",I$)=0 THEN BEEP:GOTO 2170
  66. 2260  IF T(F,Y)=3 AND INSTR("0123456789",I$)=0 THEN BEEP:GOTO 2170
  67. 2270  IF T(F,Y)=4 AND INSTR("01234567890+-",I$)=0 THEN BEEP:GOTO 2170
  68. 2280  IF LEN(IN$)+1>BL(F,Y) THEN BEEP:GOTO 2170
  69. 2290  IN$=IN$+I$:WRT=1
  70. 2300  IF T(F,Y)<>3 THEN 2310 ELSE IF VAL(MID$(IN$,1,2))>12 THEN BEEP:GOTO 2150 ELSE IF VAL(MID$(IN$,3,2))>31 THEN BEEP:GOTO 2150
  71. 2310  IF T(F,Y)=1 OR T(F,Y)=2 THEN LOCATE R,C:PRINT IN$:GOTO 2170
  72. 2320  IF T(F,Y)=3 THEN LOCATE R,C: PRINT LEFT$(IN$,2);"/";MID$(IN$,3,2);"/";MID$(IN$,5,2):GOTO 2170
  73. 2330  IF T(F,Y)=4 THEN LOCATE R,C:PRINT USING RIGHT$(MF$,BL(F,Y)+1);VAL(IN$):GOTO 2170
  74. 2350  REM
  75. 3000  REM START OF THE PROGRAM
  76. 3010  TIMER ON: ON TIMER (1) GOSUB 10000:
  77. 3020  RESET:GOSUB 1130:GOSUB 1170:LOCATE 25,1:PRINT STRING$(79,32);
  78. 3030  LOCATE 5,1:COLOR 9: PRINT "INSTRUCTIONS":COLOR 7,0:PRINT"You will have to pick a file for the primary sort. This means that all records  from this file will be sorted, even if more than one are linked to a master file";
  79. 3040  PRINT "The file for the secondary sort (if you have one) will be sorted if it is linkedto the records of the file for the primary sort. "
  80. 3050  PRINT "YOU MAY USE ONLY ONE SUB-FILE IN A SORT!"
  81. 3060  LOCATE 22,3:COLOR 15: PRINT "INDICATE NUMBER OF FILE FOR PRIMARY SORT": COLOR 7,0: LOCATE 12,,20: PRINT "These are your files":PRINT:FOR F=0 TO TF: LOCATE ,20:PRINT F".   ";F$(F):NEXT:COLOR 7,0
  82. 3070  A$=INKEY$: IF A$="" THEN 3070
  83. 3080  IF INSTR("1234567890",A$)=0 THEN GOSUB 1270:GOTO 3060
  84. 3090  PF=VAL(A$): IF PF>TF THEN GOSUB 1270:GOTO 3060
  85. 3100  LOCATE 22,3:COLOR 15: BEEP:PRINT "INDICATE NUMBER OF FILE FOR **SECONDARY** SORT" :LOCATE 21,3:PRINT "Press 'ENTER' to indicate NO file for secondary sort":COLOR 7,0
  86. 3110  A$=INKEY$: IF A$="" THEN 3110
  87. 3120  IF INSTR("1234567890"+CHR$(13),A$)=0 THEN GOSUB 1270:GOTO 3110
  88. 3130  IF A$=CHR$(13) THEN SF=7:GOTO 3150
  89. 3140  SF=VAL(A$): IF SF>TF THEN GOSUB 1270:GOTO 3060 ELSE BEEP
  90. 3150  GOSUB 1130:GOSUB 1170
  91. 3160  FOR K=1 TO 8
  92. 3170  REM K1 FILE,K2 FIELD,K3 BB,K4 LENGTH
  93. 3180  LOCATE 20,3: PRINT "INDICATE KEYS FOR SORT"
  94. 3190  IF SF=7 THEN K(K,1)=PF: GOTO 3270
  95. 3200  DEF SEG:POKE &H6A,0:DEF SEG=0:POKE 1052,PEEK(1050)
  96. 3210  LOCATE 21,3:PRINT "FILE (1) PRIMARY: ";F$(PF);" OR (2) SECONDARY: ";F$(SF) ";:
  97. 3220  K$=INKEY$:IF K$="" THEN 3220
  98. 3230  IF K$<>"1" AND K$<>"2" AND K$<>"0" THEN GOSUB 1270:GOSUB 1150:GOTO 3230
  99. 3240  IF K$="0" THEN TK=K-1: K=9: GOTO 3460
  100. 3250  IF K$="1" THEN F=PF ELSE F=SF:
  101. 3260  K(K,1)=F
  102. 3270  GOSUB 1140:F=K(K,1):GOSUB 9300
  103. 3280  LOCATE 21,3: INPUT "INDICATE FIELD FOR SORT ";K$
  104. 3290  IF K$="" THEN GOSUB 1270:GOTO 3280
  105. 3300  IF VAL(K$)>TE(K(K,1)) THEN GOSUB 1275:GOTO 3280
  106. 3310  IF K(K,1)=0 AND VAL(K$)<1 THEN GOSUB 1270:GOTO 3280
  107. 3320  IF K(K,1)>0 AND VAL(K$)<0 THEN GOSUB 1270:GOTO 3280
  108. 3330  K(K,2)=VAL(K$):Y=VAL(K$)
  109. 3340  GOSUB 1150:LOCATE 21,3: PRINT "FILE: ";F$(F);"  FIELD: ";T$(F,Y):LOCATE 22,3:INPUT "INDICATE BEGINNING BYTE OR PRESS 'ENTER' ";B$
  110. 3350  IF B$="" THEN K(K,3)=BB(F,Y):GOTO 3380
  111. 3360  IF VAL(B$)<BB(F,Y) THEN GOSUB 1270:GOTO 3340
  112. 3370  K(K,3)=VAL(B$)
  113. 3380  GOSUB 1150:LOCATE 21,3: PRINT "FILE: ";F$(F);"  FIELD: ";T$(F,Y);" BEG. ";K(K,3):LOCATE 22,3:INPUT "INDICATE LENGTH OR PRESS 'ENTER' ";L$
  114. 3390  IF T(F,Y)=3 AND L$="" AND K(K,3)=BB(F,Y) THEN K(K,3)=BB(F,Y)+4:K(K,4)=2:K=K+1:K(K,3)=BB(F,Y):K(K,4)=4:K(K,1)=K(K-1,1):K(K,2)=K(K-1,2):GOTO 3430
  115. 3400  IF VAL(L$)=0 THEN K(K,4)=BL(F,Y):IF K(K,4)>5 THEN K(K,4)=5:GOTO 3430 ELSE GOTO 3430
  116. 3410  IF VAL(L$)<1 OR VAL(L$)>BL(F,Y) THEN GOSUB 1270:GOTO 3380
  117. 3420  K(K,4)=VAL(L$)
  118. 3430  GOSUB 1150:LOCATE 21,3: INPUT "DO YOU WANT TO ENTER ANOTHER KEY (Y/N) ";AN$
  119. 3440  IF AN$="Y" OR AN$="y" OR AN$="" THEN 3450 ELSE TK=K:K=10:GOTO 3460
  120. 3450  GOSUB 1150:NEXT K
  121. 3460  GOSUB 1130:GOSUB 1170:COLOR 9:LOCATE 5,1:PRINT "SORTING KEYS.... PRIMARY: ";F$(PF);:IF SF<>7 THEN PRINT "  SECONDARY: ";F$(SF) ELSE PRINT
  122. 3470  COLOR 7,0:PRINT
  123. 3480  COLOR 0,7:PRINT "KEY    FILE              FIELD           BEGINNING   LENGTH":COLOR 7,0
  124. 3490  FOR K=1 TO TK:LOCATE 8+K,1:PRINT K".";:LOCATE 8+K,8:PRINT F$(K(K,1));:LOCATE 8+K,26:PRINT T$(K(K,1),K(K,2));:LOCATE 8+K,43:PRINT K(K,3);:LOCATE 8+K,55:PRINT K(K,4)
  125. 3500  NEXT
  126. 3510  LOCATE 22,3:INPUT "DO YOU WANT TO SAVE THESE KEYS NOW (Y/N) ";AN$
  127. 3520  IF AN$="Y" OR AN$="y" OR AN$="" THEN GOSUB 5000 ELSE 3010
  128. 3530  SI$=DR$(F)+":"+"F"+MID$(STR$(PF),2)+".INX"
  129. 3540  REM MAY OR MAY NOT HAVE TO REWRITE KEY FIELDS
  130. 3550  IF SF<>7 THEN 3610
  131. 3560  REM NO REWRITE NECESSARY
  132. 3570  LOCATE 22,3:PRINT "NO RE-WRITE NECESSARY                              "
  133. 3600  G1$=DR$(PF)+":"+F$(PF):GOTO 3920
  134. 3610  REM SECONDARY FILE REWRITE KEY FIELDS
  135. 3620  GOSUB 5000:
  136. 3630  GOSUB 1130:GOSUB 1170
  137. 3640  LOCATE 7,1:COLOR 9:PRINT "CREATION OF FILE OF KEY FIELDS":COLOR 7,0
  138. 3650  PRINT:PRINT "You will be asked to indicate:":PRINT "(1) the drive that contains the primary file: ";F$(PF):PRINT "(2) the drive that contains the secondary:    ";F$(SF):PRINT
  139. 3660  PRINT"In addition, one of the disks must contain enough room to allow you to write    the key fields file to be used for sorting."
  140. 3670  PRINT "The sorted index is always written on the data disk"
  141. 3675  PRINT "The Index File will be named after the file for the primary sort: F";MID$(STR$(PF),2,1);".INX"
  142. 3680  LOCATE 21,3:PRINT"Primary:    ";F$(PF);" ";:INPUT "Drive (A-H) ";PD$
  143. 3690  IF INSTR("ABCDEFGHabcdefgh",PD$)=0 THEN GOSUB 1270:GOTO 3680
  144. 3700  DR$(PF)=PD$
  145. 3710  LOCATE 22,3:PRINT"Secondary:  ";F$(SF);" ";:INPUT "Drive (A-H) ";SD$
  146. 3720  IF INSTR("ABCDEFGHabcdefgh",SD$)=0 THEN GOSUB 1270:GOTO 3710
  147. 3730  DR$(SF)=SD$
  148. 3740  GOSUB 1150:LOCATE 21,3:PRINT"Drive for the KEY fields:   ";:INPUT "Drive (A-H) ";KD$
  149. 3745  GOSUB 1150: COLOR 9:LOCATE 21,3:PRINT "REC":LOCATE 21,10:PRINT "KEY FOR SORT":COLOR 7,0
  150. 3750  IF INSTR("ABCDEFGHabcdefgh",KD$)=0 THEN GOSUB 1270:GOTO 3730
  151. 3760  KD$=KD$+":KEY"
  152. 3770  F=PF:GOSUB 1810:F=SF:GOSUB 1810:REM open file
  153. 3771  ON ERROR GOTO 3779
  154. 3772  KILL KD$:GOTO 3780
  155. 3779  RESUME 3780
  156. 3780  OPEN KD$ AS #7 LEN=KL:FIELD #7,KL-1 AS R$
  157. 3790  FOR X=1 TO NR(PF)-1:
  158. 3800  GET #PF+1,X: IF PF=0 AND FNPN(SF)<>0 THEN GET#SF+1,FNPN(SF) ELSE LSET P$(SF)="":FOR Y=1 TO TE(SF):LSET X$(SF,Y)="":NEXT
  159. 3810  IF SF=0 AND FNMFP(PF)<>0 THEN GET #1,FNMFP(PF) ELSE IF SF=0 AND FNMFP(PF)=0 THEN 3870:REM DON'T USE SUB-FILE IF NOT LINKED TO MASTER FILE
  160. 3820  IF LEFT$(P$(PF),1)="*" THEN 3870
  161. 3830  T=0:FOR K=1 TO TK
  162. 3840  LSET R$=LEFT$(R$,T)+MID$(X$(K(K,1),K(K,2)), 1+K(K,3)-BB(K(K,1),K(K,2)),K(K,4)):T=T+K(K,4)
  163. 3850  NEXT
  164. 3860  PUT #7,X:
  165. 3865  LOCATE 22,3:PRINT X:LOCATE 22,10:PRINT R$
  166. 3870  NEXT:CLOSE
  167. 3880  GOSUB 1130:GOSUB 1170:LOCATE 22,3:PRINT "INSERT PROGRAM DISK INTO ACTIVE DRIVE":LOCATE 23,3:PRINT "HIT ANY KEY WHEN READY ";:GOSUB 1260
  168. 3890  A$=INKEY$: IF A$="" THEN 3890 ELSE BEEP:GOSUB 1150:LOCATE 22,3:PRINT "LOADING SORTING MODULE"
  169. 3900  G1$=KD$
  170. 3920  REM GO OFF TO SORT
  171. 3940  REM G1$ IS FILE TO SORT, G2$ IS INDEX, G3$ IS "SRT.PRM"
  172. 3950  LOCATE 10,1:G3$=DR$(F)+":"+"SRT.PRM": G2$=SI$:
  173. 3955  GOSUB 1140
  174. 3960  CHAIN "SRT"
  175. 5000  GOSUB 1860
  176. 5001  LOCATE 10,1:G3$=DR$(F)+":"+"SRT.PRM": G2$=DR$(F)+":"+"F"+MID$(STR$(PF),2)+".INX": G1$=DR$(F)+":"+F$(F)
  177. 5002  OPEN G3$ FOR OUTPUT AS 1
  178. 5005  A$="S("
  179. 5010  T=1:FOR K=1 TO TK
  180. 5020  F=K(K,1):Y=K(K,2):IF SF=7 THEN A$=A$+STR$(K(K,3))+","+STR$(K(K,4))+",":GOTO 5030
  181. 5025  A$=A$+STR$(T)+","+STR$(K(K,4))+","
  182. 5030  IF T(F,Y)=1 THEN A$=A$+"ALP,A":GOTO 5080
  183. 5040  IF T(F,Y)=2 THEN A$=A$+"N,A":GOTO 5080
  184. 5050  IF T(F,Y)=3 THEN A$=A$+"N,A":GOTO 5080
  185. 5060  IF T(F,Y)=4 THEN A$=A$+"N,A":GOTO 5080
  186. 5070  IF T(F,Y)=5 THEN A$=A$+"C,A":GOTO 5080
  187. 5080  IF K<>TK THEN A$=A$+","
  188. 5090  T=T+K(K,4):NEXT K:
  189. 5100  IF SF=7 THEN A$=A$+") AD R("+STR$(LL(PF))+")" ELSE A$=A$+") AD w("+DR$(K(K,1))+":) R("+STR$(T)+")":KL=T
  190. 5110  PRINT #1,A$:CLOSE:RETURN
  191. 6000  REM DISPLAY
  192. 6010  GOSUB 1140:E1=1:IF F=F1 AND F2>10 THEN E1=F2
  193. 6020  COLOR 15:LOCATE 2,10:PRINT F:LOCATE 2,15:PRINT LEFT$(F$(F)+"             ",10):LOCATE 2,45:PRINT X;"/";NR(F)-1;"    ":LOCATE 2,74:PRINT XM;"  "
  194. 6030  IF E1+10=>TE(F) THEN E2=TE(F) ELSE E2=E1+10
  195. 6040  FOR Y=E1 TO E2:COLOR 7,0:LOCATE FNL(Y),1:PRINT LEFT$(STR$(Y)+". "+T$(F,Y)+"               ",15);" ";:COLOR 0,7
  196. 6050  IF T(F,Y)=1 OR T(F,Y)=2 THEN PRINT X$(F,Y):GOTO 6080
  197. 6060  IF T(F,Y)=3 AND LEN(X$(F,Y))>2 THEN PRINT MID$(X$(F,Y),1,2);"/";MID$(X$(F,Y),3,2);"/";MID$(X$(F,Y),5,2):GOTO 6080 ELSE IF T(F,Y)=3 THEN PRINT X$(F,Y):GOTO 6080
  198. 6070  IF T(F,Y)=4 THEN PRINT USING RIGHT$(MF$,BL(F,Y)+1);VAL(X$(F,Y))
  199. 6080  NEXT:COLOR 7,0:
  200. 6090  IF F=F1 AND F2>E1 AND F2<=E2 THEN E1=F2
  201. 6100  RETURN
  202. 9000  REM EXIT
  203. 9010  RESET:RUN "MENU
  204. 9110  COLOR 9:PRINT "F10":COLOR 7,0:PRINT " Return to Menu"
  205. 9300  COLOR 15:LOCATE 5,1:PRINT "FILE: ";F$(F);"     ENTRIES: ";TE(F);"   LENGTH: ";LL(F)"   DRIVE: ";DR$(F)
  206. 9305  T$(F,0)="POINTERS":T(F,0)=5:BL(F,0)=4: BB(F,0)=1
  207. 9310  LOCATE 7,1: COLOR 9:PRINT "#     TITLE          TYPE     BEGINNING         LENGTH":COLOR 15
  208. 9320  IF F<>0 THEN E1=0:GOTO 9340 ELSE E1=1:GOTO 9340
  209. 9340  COLOR 15:IF E1+ 9=>TE(F) THEN E2=TE(F) ELSE E2=E1+9
  210. 9350  FOR Y=E1 TO E2
  211. 9360  IF Y=0 THEN LOCATE 8,1 ELSE LOCATE 8+(Y MOD 10)+(-10*(Y MOD 10 =0)),1
  212. 9361  PRINT Y".  ";LEFT$(T$(F,Y)+"                         ",24);
  213. 9370  LOCATE ,22:IF T(F,Y)=1 THEN PRINT "ALPHA "; ELSE IF T(F,Y)=2 THEN PRINT "NUMBER"; ELSE IF T(F,Y)=3 THEN PRINT "DATE  "; ELSE IF T(F,Y)=4 THEN PRINT "$$$.$$"; ELSE PRINT "      ";
  214. 9380  PRINT  "     ";BB(F,Y);"              ";BL(F,Y):NEXT:COLOR 7,0
  215. 9390  GOSUB 1150: IF E2<TE(F) THEN LOCATE 22,3: INPUT "Press the 'ENTER' key to continue ";AN$: IF VAL(AN$)<>0 THEN K$=AN$:RETURN ELSE E1=E2+1:GOTO 9340
  216. 9395  RETURN
  217. 9400  REM
  218. 9410  LOCATE 12,20:COLOR 15: PRINT "INDICATE NUMBER OF FILE FOR PRIMARY SORT": FOR F=0 TO TF: LOCATE ,20:PRINT F".   ";F$(F):NEXT:COLOR 7,0
  219. 10000  OLDROW=CSRLIN:OLDCOL=POS(0):LOCATE 2,3:PRINT TIME$:LOCATE OLDROW,OLDCOL:RETURN
  220. 30000  OLDROW=CSRLIN:OLDCOL=POS(0):OPEN "ERROR" AS #7 LEN=176:FIELD #7,35 AS ER$(1),70 AS ER$(2),70 AS ER$(3):GET#7,ERR
  221. 30010  LOCATE 20,3:PRINT LEFT$(ER$(1),INSTR(ER$(1),"  ")+(-40*INSTR(ER$(1),"  ")=0));" IN LINE ";ERL;" (Press any key)":LOCATE 21,3:PRINT ER$(2):LOCATE 22,3:PRINT ER$(3):PLAY"MB":J9=2:FOR I9=1 TO 9:PLAY"L64T255O=J9;CC#DD#EFF#GG#AA#B":NEXT
  222. 30020  AE$=INKEY$:IF AE$=""THEN 30020 ELSE FOR EL=20 TO 22:LOCATE EL,3:PRINT STRING$(76,32);:NEXT:LOCATE OLDROW,OLDCOL:CLOSE#3:RESUME
  223. 40000  REM **********************************************************
  224. 40010  REM **********************************************************
  225. 40020  REM ** COPYRIGHT (C) 1984, 1988  GERALD E. GONDERINGER      **
  226. 40030  REM ** The Omaha DataBase Program                           **
  227. 40040  REM ** $50.00 REGISTRATION FEE FOR USE OF PROGRAM           **
  228. 40050  REM **********************************************************
  229. 40060  REM **********************************************************
  230.